home *** CD-ROM | disk | FTP | other *** search
/ Amoszine 6 / Amoszine 6 (Disk 2 of 2).adf / extra_source.lha / OTHER_SOURCE / QUICKSORT.Amos / QUICKSORT.amosSourceCode
Encoding:
AMOS Source Code  |  1992-02-26  |  3.2 KB  |  124 lines

  1. Dim _ARRAY$(10,1)
  2. For A=1 To 10
  3.    Read _ARRAY$(A,0),_ARRAY$(A,1)
  4. Next 
  5. Data "fred","blogs"
  6. Data "some","body"
  7. Data "some","bodyelse"
  8. Data "mr","bean"
  9. Data "super","man"
  10. '
  11. Data "spider","man"
  12. Data "another","insect man"
  13. Data "flyspray","man"
  14. Data "mighty","midget"
  15. Data "captain","marrow"
  16. '
  17. Print "Before...." : Print 
  18. For A=1 To 10
  19.    Print _ARRAY$(A,0),_ARRAY$(A,1)
  20. Next 
  21. Print : Print "Press a key" : Wait Key 
  22. QUICKSORT[10,1]
  23. Cls : Home 
  24. Print "After...." : Print 
  25. For A=1 To 10
  26.    Print _ARRAY$(A,0),_ARRAY$(A,1)
  27. Next 
  28. End 
  29.  
  30. Procedure QUICKSORT[NO,ST]
  31. Shared _ARRAY$()
  32. '
  33. 'NO = Maximum element of _ARRAY in the dimension it is to be sorted in   
  34. 'ST = First element of _ARRAY to sort (usually 0 or 1)   
  35. '
  36. '_ARRAY$() = The array to be sorted. Use Global replace to change it   
  37. '           to your array.   
  38. '
  39. 'Define NOA$(A) to be the key to sort on where A is the array row in the     
  40. 'dimension it is to be sorted on 
  41. '  
  42.    Def Fn NOA$(A)=_ARRAY$(A,0)+_ARRAY$(A,1)
  43. '
  44. 'QuickSort Procedure - Don't Change
  45. '
  46. '   Comp Test Off
  47.    Reserve As Work 9,NO*4+10 : STACK=1
  48.    Doke Start(9),ST : Doke Start(9)+2,NO
  49.    While STACK>0
  50.       Dec STACK
  51.       S=Deek(Start(9)+STACK*4) : E=Deek(Start(9)+STACK*4+2)
  52.       While S<E
  53.          SPLIT=S : I=Int((S+E)/2)
  54.          If Fn NOA$(I)< Fn NOA$(E)
  55.             If Fn NOA$(I)< Fn NOA$(S)
  56.                If Fn NOA$(S)< Fn NOA$(E)
  57.                   PIVOT=S
  58.                Else 
  59.                   PIVOT=E
  60.                End If 
  61.             Else 
  62.                PIVOT=I
  63.             End If 
  64.          Else 
  65.             If Fn NOA$(I)< Fn NOA$(S)
  66.                PIVOT=I
  67.             Else 
  68.                If Fn NOA$(S)< Fn NOA$(E)
  69.                   PIVOT=E
  70.                Else 
  71.                   PIVOT=S
  72.                End If 
  73.             End If 
  74.          End If 
  75.          PIVOT$= Fn NOA$(PIVOT)
  76.          If PIVOT>S
  77.             '
  78.             '****************************************************  
  79.             'Modify this code to swap array elements PIVOT and S   
  80.             '
  81.             Swap _ARRAY$(PIVOT,0),_ARRAY$(S,0)
  82.             Swap _ARRAY$(PIVOT,1),_ARRAY$(S,1)
  83.             '
  84.             '****************************************************
  85.             PIVOT=S
  86.          End If 
  87. '
  88. '
  89.          For I=S+1 To E
  90.             If Fn NOA$(I)<PIVOT$
  91.                Inc SPLIT
  92.                '
  93.                '********************************************************
  94.                'MOdify this code to swap elements SPLIT & I 
  95.                '
  96.                Swap _ARRAY$(I,0),_ARRAY$(SPLIT,0)
  97.                Swap _ARRAY$(I,1),_ARRAY$(SPLIT,1)
  98.                '
  99.                '********************************************************
  100.             End If 
  101.          Next 
  102. '
  103. '
  104.          '********************************************************* 
  105.          'Modify this code to swap elements PIVOT & SPLIT 
  106.          '
  107.          Swap _ARRAY$(PIVOT,0),_ARRAY$(SPLIT,0)
  108.          Swap _ARRAY$(PIVOT,1),_ARRAY$(SPLIT,1)
  109.          '
  110.          '********************************************************* 
  111. '      
  112.       Doke Start(9)+STACK*4+2,E
  113.       Doke Start(9)+STACK*4,SPLIT+1
  114.       Inc STACK
  115.       E=SPLIT-1
  116.       'Comp Test 
  117.       I$=Inkey$ : SC=Scancode : Exit If SC=69,2
  118.       Wend 
  119.    Wend 
  120. '
  121.    Erase 9
  122.    F=Free
  123. '   Comp Test On 
  124. End Proc